home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
FM Towns: Free Software Collection 6
/
FM Towns Free Software Collection 6.iso
/
t_os
/
algernon
/
vil_bas.bas
< prev
next >
Wrap
BASIC Source File
|
1993-07-08
|
9KB
|
243 lines
40030 *VIL_BAS_VER
40035 VIL_VER=100
40040 RETURN
40070 *VIL_BEEP_INITM
40120 RETURN
40130 *VIL_GBEEP
40170 FOR VIL_K=1 TO 4:BEEP 363523,5,400:WAIT 5:NEXT
40175 RETURN
40185 *VIL_BBEEP
40225 BEEP 363523,40,80:WAIT 40
40230 RETURN
40270 *VIL_WIN_INITM
40320 VIL_WX=0:VIL_WY=0
40325 VIL_WW=0:VIL_WZ=0
40330 VIL_WUB=0:VIL_WDB=0
40335 VIL_WLB=0:VIL_WRB=0
40340 VIL_WAN=0
40345 VIL_WPM=0
40350 VIL_WBUFMAX=VIL_W0
40355 VIL_WANMAX=VIL_W1
40360 DIM VIL_WBUF%(VIL_W0)
40365 DIM VIL_WBUFO(VIL_W1)
40370 DIM VIL_WX(VIL_W1),VIL_WY(VIL_W1)
40375 DIM VIL_WW(VIL_W1),VIL_WZ(VIL_W1)
40385 VIL_WX(0)= 0:VIL_WY(0)= 0
40390 VIL_WW(0)=639:VIL_WZ(0)=479
40400 RETURN
40410 *VIL_WOP
40480 GOSUB *VIL_WPMA
40485 VIL_WAN=VIL_WAN+1
40490 VIL_WX(VIL_WAN)=VIL_WX:VIL_WY(VIL_WAN)=VIL_WY
40495 VIL_WW(VIL_WAN)=VIL_WW:VIL_WZ(VIL_WAN)=VIL_WZ
40500 VIL_WBUFO(VIL_WAN)=VIL_WBUFO(VIL_WAN-1) +INT((INT((VIL_WW-VIL_WX+VIL_WLB+VIL_WRB+8)/8) *(VIL_WZ-VIL_WY+VIL_WUB+VIL_WDB+1)*4+1)/2)
40505 VIL_E=0
40510 GET@A(VIL_WX-VIL_WLB,VIL_WY-VIL_WUB)-(VIL_WW+VIL_WRB,VIL_WZ+VIL_WDB), VIL_WBUF%,VIL_WBUFO(VIL_WAN-1)
40515 IF VIL_E THEN
40520 VIL_WAN=VIL_WAN-1
40525 VIL_WX=VIL_WX(VIL_WAN):VIL_WY=VIL_WY(VIL_WAN)
40530 VIL_WW=VIL_WW(VIL_WAN):VIL_WZ=VIL_WZ(VIL_WAN)
40535 ENDIF
40540 RETURN
40550 *VIL_WCL
40600 GOSUB *VIL_WPMA
40605 PUT@A(VIL_WX(VIL_WAN)-VIL_WLB,VIL_WY(VIL_WAN)-VIL_WUB) -(VIL_WW(VIL_WAN)+VIL_WRB,VIL_WZ(VIL_WAN)+VIL_WDB), VIL_WBUF%,,,,,VIL_WBUFO(VIL_WAN-1)
40610 VIL_WAN=VIL_WAN-1
40615 VIL_WX=VIL_WX(VIL_WAN):VIL_WY=VIL_WY(VIL_WAN)
40620 VIL_WW=VIL_WW(VIL_WAN):VIL_WZ=VIL_WZ(VIL_WAN)
40625 RETURN
40635 *VIL_WCLDMY
40685 GOSUB *VIL_WPMA
40690 VIL_WAN=VIL_WAN-1
40695 VIL_WX=VIL_WX(VIL_WAN):VIL_WY=VIL_WY(VIL_WAN)
40700 VIL_WW=VIL_WW(VIL_WAN):VIL_WZ=VIL_WZ(VIL_WAN)
40705 RETURN
40715 *VIL_WCLALL
40765 WHILE VIL_WAN
40770 GOSUB *VIL_WCL
40775 WEND
40780 RETURN
40790 *VIL_WPMR
40830 VIL_WPM=-1
40835 VIEW(VIL_WX,VIL_WY)-(VIL_WW,VIL_WZ)
40840 WINDOW(0,0)-(VIL_WW-VIL_WX,VIL_WZ-VIL_WY)
40845 RETURN
40855 *VIL_WPMA
40895 VIL_WPM=0
40900 VIEW(0,0)-(639,479)
40905 WINDOW(0,0)-(639,479)
40910 RETURN
40940 *VIL_MSEL_INITM
40990 VIL_MN=0
40995 VIL_BN=0
41000 VIL_BCE=0
41005 VIL_BXDIR=0
41025 DIM VIL_BXX(VIL_W1),VIL_BXY(VIL_W1)
41030 DIM VIL_BXW(VIL_W1),VIL_BXZ(VIL_W1)
41035 DIM VIL_BN(VIL_W0)
41045 FOR VIL_I=1 TO VIL_W0
41050 VIL_BN(VIL_I)=1
41055 NEXT
41065 MOUSE 0:MOUSE 1,320,240,0
41070 RETURN
41080 *VIL_MSEL
41260 GOSUB *VIL_BCMAKE
41265 GOSUB *VIL_MSELIN
41270 RETURN
41280 *VIL_BCMAKE
41370 IF VIL_BXDIR AND 2 THEN VIL_W1=-1 ELSE VIL_W1=1
41375 IF VIL_BXDIR AND 4 THEN VIL_W2=-1 ELSE VIL_W2=1
41380 FOR VIL_I=1 TO VIL_YN
41385 FOR VIL_J=1 TO VIL_XN
41390 IF VIL_BXDIR AND 1 THEN
41395 VIL_W0=(VIL_J-1)*VIL_YN+VIL_I
41400 ELSE
41405 VIL_W0=(VIL_I-1)*VIL_XN+VIL_J
41410 ENDIF
41415 VIL_BXX(VIL_W0)=VIL_X+(VIL_J-1)*VIL_XL*VIL_W1
41420 VIL_BXY(VIL_W0)=VIL_Y+(VIL_I-1)*VIL_YL*VIL_W2
41425 VIL_BXW(VIL_W0)=VIL_W+(VIL_J-1)*VIL_XL*VIL_W1
41430 VIL_BXZ(VIL_W0)=VIL_Z+(VIL_I-1)*VIL_YL*VIL_W2
41435 NEXT
41440 NEXT
41445 RETURN
41455 *VIL_MSELIN
41630 VIL_W0=MOUSE(3,0)+MOUSE(3,1)
41635 VIL_W0=VIL_XN*VIL_YN
41640 VIL_W1=28:VIL_W2=29:VIL_W3=30:VIL_W4=31
41645 IF VIL_BXDIR AND 2 THEN SWAP VIL_W1,VIL_W2
41650 IF VIL_BXDIR AND 4 THEN SWAP VIL_W3,VIL_W4
41655 IF VIL_BXDIR AND 1 THEN SWAP VIL_W1,VIL_W4:SWAP VIL_W2,VIL_W3
41675 MOUSE 1,,,1
41680 IF VIL_MN THEN VIL_BN=VIL_BN(VIL_MN)
41685 IF VIL_BN<1 OR VIL_W0<VIL_BN THEN VIL_BN=1
41690 IF VIL_BCE=0 THEN GOSUB *VIL_BC
41700 VIL_K$=INKEY$
41705 IF VIL_K$<>"" THEN VIL_KY=ASC(VIL_K$) ELSE VIL_KY=0
41715 IF MOUSE(3,1) OR VIL_KY=48 OR VIL_KY=24 THEN
41720 VIL_W0=MOUSE(3,0)
41725 VIL_KN=0
41730 ELSE IF MOUSE(3,0) OR MOUSE(2,0) THEN
41735 VIL_KN=-1
41740 VIL_MX=MOUSE(0):VIL_MY=MOUSE(1)
41745 IF VIL_WPM THEN
41750 IF VIL_WPM AND VIL_WX<=VIL_MX AND VIL_MX<=VIL_WW AND VIL_WY<=VIL_MY AND VIL_MY<=VIL_WZ THEN
41755 VIL_MW=VIL_MX-VIL_WX:VIL_MZ=VIL_MY-VIL_WY
41760 FOR VIL_I=1 TO VIL_XN
41765 IF VIL_BXX(VIL_I)=<VIL_MW AND VIL_MW=<VIL_BXW(VIL_I) THEN
41770 FOR VIL_J=VIL_I TO VIL_W0 STEP VIL_XN
41775 IF VIL_BXY(VIL_J)=<VIL_MZ AND VIL_MZ=<VIL_BXZ(VIL_J) THEN
41780 VIL_KN=VIL_J
41785 GOSUB *VIL_BC
41790 VIL_BN=VIL_KN
41795 GOSUB *VIL_BC
41800 VIL_I=VIL_W0:VIL_J=VIL_W0
41805 ENDIF
41810 NEXT
41815 ENDIF
41820 NEXT
41825 ENDIF
41830 ELSE
41835 VIL_MW=-1
41840 FOR VIL_I=1 TO VIL_XN
41845 IF VIL_BXX(VIL_I)=<VIL_MX AND VIL_MX=<VIL_BXW(VIL_I) THEN
41850 FOR VIL_J=VIL_I TO VIL_W0 STEP VIL_XN
41855 IF VIL_BXY(VIL_J)=<VIL_MY AND VIL_MY=<VIL_BXZ(VIL_J) THEN
41860 VIL_KN=VIL_J
41865 GOSUB *VIL_BC
41870 VIL_BN=VIL_KN
41875 GOSUB *VIL_BC
41880 VIL_I=VIL_W0:VIL_J=VIL_W0
41885 ENDIF
41890 NEXT
41895 ENDIF
41900 NEXT
41905 ENDIF
41910 ELSE
41915 IF VIL_KY=0 THEN
41920 GOTO 41700
41925 ELSE IF 48<VIL_KY AND VIL_KY<58 THEN
41930 IF VIL_KY<VIL_W0+49 THEN
41935 VIL_KN=VIL_KY-48:GOSUB *VIL_BC
41940 VIL_BN=VIL_KN:GOSUB *VIL_BC
41945 ELSE
41950 VIL_KN=-2
41955 ENDIF
41960 ELSE IF VIL_KY=13 THEN
41965 VIL_KN=VIL_BN
41970 ELSE IF 27<VIL_KY AND VIL_KY<32 THEN
41975 GOSUB *VIL_BC
41980 VIL_BN=VIL_BN-(VIL_KY=VIL_W1)+(VIL_KY=VIL_W2) +((VIL_KY=VIL_W3)-(VIL_KY=VIL_W4))*VIL_XN
41985 VIL_BN=VIL_BN+(VIL_KY=VIL_W1 AND (VIL_BN MOD VIL_XN)=1)*VIL_XN
41990 VIL_BN=VIL_BN-(VIL_KY=VIL_W2 AND ((VIL_BN+1) MOD VIL_XN)=1)*VIL_XN
41995 VIL_BN=VIL_BN-((VIL_BN<1)-(VIL_BN>VIL_W0))*VIL_W0
42000 GOSUB *VIL_BC
42005 GOTO 41700
42010 ELSE
42015 VIL_KN=-2
42020 ENDIF
42025 ENDIF
42035 VIL_BN(VIL_MN)=VIL_BN
42040 MOUSE 1,,,0
42045 VIL_BCE=-1
42050 RETURN
42060 *VIL_BC
42100 LINE(VIL_BXX(VIL_BN),VIL_BXY(VIL_BN)) -(VIL_BXW(VIL_BN),VIL_BXZ(VIL_BN)),XOR,%VIL_C,B
42105 RETURN
42135 *VIL_INP_INITM
42185 MOUSE 0:MOUSE 1,320,240,0
42190 RETURN
42200 *VIL_INPSTR
42325 VIL_W0=LEN(VIL_A$):VIL_W1=VIL_W0
42330 MOUSE 1,,,1
42340 GOSUB *VIL_GPRINT
42345 GOSUB 42560
42355 VIL_K$=INKEY$
42360 IF VIL_K$<>"" THEN VIL_KY=ASC(VIL_K$) ELSE VIL_KY=0
42370 IF MOUSE(3,1) OR VIL_KY=24 THEN
42375 VIL_KN=0
42380 ELSE IF MOUSE(3,0) OR MOUSE(2,0) THEN
42385 VIL_MX=MOUSE(0):VIL_MY=MOUSE(1)
42390 IF VIL_WPM THEN
42395 IF VIL_WPM AND VIL_WX<=VIL_MX AND VIL_MX<=VIL_WW AND VIL_WY<=VIL_MY AND VIL_MY<=VIL_WZ THEN
42400 VIL_MW=VIL_MX-VIL_WX:VIL_MZ=VIL_MY-VIL_WY
42405 ELSE
42410 VIL_MW=-1
42415 ENDIF
42420 ENDIF
42425 VIL_KN=-1
42430 ELSE IF VIL_KY=13 THEN
42435 VIL_KN=1
42440 ELSE
42445 IF VIL_KY=0 THEN 42355
42450 GOSUB 42560
42455 IF VIL_KY=29 AND VIL_W1>0 THEN VIL_W1=VIL_W1-1:GOTO 42345
42460 IF VIL_KY=28 AND VIL_W1<VIL_W0 THEN VIL_W1=VIL_W1+1:GOTO 42345
42465 IF VIL_KY>=32 AND VIL_KY<>127 AND VIL_W0<VIL_L THEN
42470 VIL_A$=LEFT$(VIL_A$,VIL_W1)+VIL_K$+MID$(VIL_A$,VIL_W1+1)
42475 VIL_W0=VIL_W0+1:VIL_W1=VIL_W1+1
42480 ELSE IF VIL_KY=8 AND VIL_W1>0 THEN
42485 VIL_A$=LEFT$(VIL_A$,VIL_W1-1)+MID$(VIL_A$,VIL_W1+1)
42490 VIL_W0=VIL_W0-1:VIL_W1=VIL_W1-1
42495 ELSE IF VIL_KY=127 AND VIL_W1<VIL_W0 THEN
42500 VIL_A$=LEFT$(VIL_A$,VIL_W1)+MID$(VIL_A$,VIL_W1+2)
42505 VIL_W0=VIL_W0-1
42510 ELSE IF VIL_KY=11 THEN
42515 VIL_A$="":VIL_W0=0:VIL_W1=0
42520 ENDIF
42525 GOTO 42340
42530 ENDIF
42535 MOUSE 1,,,0
42540 GOSUB 42560
42545 RETURN
42560 LINE(VIL_X+VIL_W1*8,VIL_Y+17)-(VIL_X+VIL_W1*8+7,VIL_Y+17),XOR,%VIL_C
42565 RETURN
42575 *VIL_GPRINT
42635 LINE(VIL_X,VIL_Y)-(VIL_X+VIL_L*8-1,VIL_Y+15),PSET,%VIL_CB,BF
42640 SYMBOL(VIL_X,VIL_Y),VIL_A$,1,1,%VIL_C
42645 RETURN
42655 *VIL_MVWAIT
42695 VIL_W0=MOUSE(9)+MOUSE(10):VIL_W0$=INKEY$
42700 WHILE ABS(MOUSE(9))<10 AND ABS(MOUSE(10))<10 AND MOUSE(2,0)+MOUSE(2,1)=0 AND INKEY$="":WEND
42705 RETURN